home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / creator.arc / DRIVER.BAS (.txt) < prev   
Encoding:
GW-BASIC  |  1985-08-27  |  14.6 KB  |  603 lines
  1. 10  ' ADVENTURE INTERPRETER 2.1
  2. 15  '
  3. 20  ' last revision 3/1/83 by JRC
  4. 25  '
  5. 30  ' This program must be run with the version 2.1 compiler and is not
  6. 35  '   compatible with version 2.0 which was a straight copy of version 1.2.
  7. 40  '   This version uses different files.
  8. 45  '
  9. 50  ' Peter F. Levy              Jim R. Cummins
  10. 60  ' 4209 Longmeadow Way        5 Jacob St.
  11. 70  ' Ft. Worth, TX 76133        Ballston Lake, NY 12019
  12. 80  ' (817) 292-8731             CompuServe  [72155,1174]
  13. 90  '
  14. 100  KEY OFF:DEFINT A-Z:DEF SEG=0:WTH=PEEK(&H410) AND &H30:DEF SEG:FALSE=0:TRUE=NOT FALSE
  15. 110  IF WTH=&H30 THEN WTH=80:CGCARD=FALSE:FGD=7:BGD=0:BRD=0 ELSE CGCARD=TRUE:FGD=6:BGD=1:BRD=1:IF WTH=&H20 THEN WTH=80 ELSE WTH=40
  16. 120  SCREEN 0,ABS(CGCARD),0,0:COLOR FGD,BGD,BRD:WIDTH WTH:CLS
  17. 130  PRINT"ADVENTURE SYSTEM DATABASE INTERPRETER 2.1"
  18. 140  PRINT
  19. 150  PRINT"Written by Peter F. Levy":PRINT TAB(12)"4209 Longmeadow Way"
  20. 160  PRINT TAB(12)"Fort Worth, TX 76133":PRINT TAB(12)"(817) 292-8731"
  21. 170  PRINT:PRINT"Adapted and modified for the":PRINT"<<<IBM Personal Computer>>>  by"
  22. 180  PRINT TAB(12)"Jim R. Cummins":PRINT TAB(12)"5 Jacob St."
  23. 190  PRINT TAB(12)"Ballston Lake, NY 12019":PRINT TAB(12)"CompuServe  [72155,1174]":PRINT
  24. 200  MASK(0)=1:MASK(1)=2:MASK(2)=4:MASK(3)=8:MASK(4)=&H10:MASK(5)=&H20:MASK(6)=&H40:MASK(7)=&H80:MASK(8)=&H100:MASK(9)=&H200:MASK(10)=&H400
  25. 220  DEF FNX(AS$,K)=ASC(MID$(AS$,K,1))
  26. 225  DEF FNUPCS$(A$)=CHR$(ASC(A$)+32*(ASC(A$)>96 AND ASC(A$)<123))
  27. 230  DEF FNL(X)=ASC(OB$(X))
  28. 240  DEF FNZ(X)=-(X AND 127)
  29. 250  DEF FNW(X)=ASC(MID$(OB$(X),3,1))
  30. 260  ON ERROR GOTO 30000
  31. 270  LINE INPUT "Adventure name ";F$
  32. 275  I=INSTR(F$,"."):IF I>0 THEN F$=LEFT$(F$,I-1)
  33. 280  OPEN "I",2,F$+".DAT"
  34. 285  OPEN "R",1,F$+".REF",32
  35. 290  FIELD #1,32 AS AI$
  36. 295  CLS:PRINT TAB(15)"One moment please..."
  37. 300  SP$=" ":LF$=CHR$(10):REND$=STRING$(32,255)
  38. 305  GET#1,2
  39. 306  NVERBS=ASC(MID$(AI$,1,1)):NNOUNS=ASC(MID$(AI$,2,1)):NOBJ=ASC(MID$(AI$,3,1))
  40. 307  NROOM=ASC(MID$(AI$,4,1)):NMESG=ASC(MID$(AI$,5,1)):NAUTO=ASC(MID$(AI$,6,1))
  41. 308  NACT=256*ASC(MID$(AI$,7,1))+ASC(MID$(AI$,8,1))
  42. 309  AMAX=256*ASC(MID$(AI$,9,1))+ASC(MID$(AI$,10,1))
  43. 310  DIM OB$(NOBJ),RM$(NROOM),VS$(8),NS$(8),BF(32),C(255),AA$(NAUTO+1)
  44. 315  RM.INC=NOBJ:MSG.INC=RM.INC+NROOM:ACT.INC=MSG.INC+NMESG
  45. 320  DIM NDX(AMAX+ACT.INC+1)
  46. 400  INPUT #2,A$:IF RIGHT$(A$,1)=CHR$(255) THEN PRINT A$;:GOTO 450 ELSE IF (POS(0)+LEN(A$))>WTH THEN PRINT
  47. 440  PRINT A$;:GOTO 400
  48. 450  FOR I=1 TO 8:VS$(I)=INPUT$(255,#2):NEXT:VL$=INPUT$(255,#2)
  49. 460  FOR I=1 TO 8:NS$(I)=INPUT$(255,#2):NEXT:NL$=INPUT$(255,#2)
  50. 470  FOR I=1 TO 255
  51. 480  A$=INPUT$(32,#2):IF A$=REND$ THEN OB$(I)=CHR$(255):NOB=I:GOTO 510
  52. 490  OB$(I)=A$
  53. 500  IF RIGHT$(OB$(I),1)=" " THEN OB$(I)=LEFT$(OB$(I),LEN(OB$(I))-1):GOTO 500
  54. 505  NEXT I
  55. 510  FOR J=1 TO NOB-1:IF ASC(OB$(J))=255 THEN LD=LD+ASC(MID$(OB$(J),3,1))
  56. 520  NEXT J
  57. 525  IF NOB<>NOBJ THEN PRINT "ERROR - Object number mismatch";NOB;NOBJ:END
  58. 530  CR=ASC(INPUT$(1,#2))
  59. 540  FOR I=1 TO 255
  60. 550  A$=INPUT$(32,#2)
  61. 560  IF A$=REND$ THEN RM$(I)=CHR$(255):NRM=I:GOTO 575
  62. 570  RM$(I)=A$  :  NEXT I
  63. 575  IF NRM<>NROOM THEN PRINT "ERROR - Room number mismatch";NRM;NROOM:END
  64. 580  FOR I=1 TO 255
  65. 590  AA$(I)=INPUT$(1,#2):IF AA$(I)=CHR$(255) THEN NAA=I:GOTO 615
  66. 600  WHILE A$>CHR$(0) :A$=INPUT$(1,#2)
  67. 610  AA$(I)=AA$(I)+A$:WEND:NEXT
  68. 615  IF NAA<>NAUTO THEN PRINT"ERROR - Auto Action number mismatch";NAA;NAUTO:END
  69. 620  FOR I=1 TO NOBJ:INPUT#2,NDX(I):NEXT
  70. 630  FOR I=1 TO NROOM:INPUT#2,NDX(I+RM.INC):NEXT
  71. 640  FOR I=1 TO NMESG:INPUT#2,NDX(I+MSG.INC):NEXT
  72. 650  FOR I=1 TO AMAX:INPUT#2,NDX(I+ACT.INC):NEXT
  73. 660  CLOSE #2
  74. 670  RE$=STRING$(255,"N")
  75. 680  HE=100:LS=TRUE
  76. 690  UW$=" A AN AT TO THE WITH IN ON SOME OFF OF INTO "
  77. 700  LOCATE 25,5:PRINT"[Depress space bar to begin play.]";
  78. 710  A$=INKEY$: IF A$<>" " THEN 710
  79. 720  CLS
  80. 1000  '
  81. 1010  ' UPDATE SCREEN DISPLAY
  82. 1020  ' ---------------------
  83. 1030  IF LS=FALSE AND R1<>CR THEN PRINT"It's too dark to see anything.":GOTO 2000
  84. 1040  IF R1<>CR THEN PRINT MID$(RM$(CR),7,25)
  85. 1050  IF MID$(RE$,CR,1)="Y" THEN 1100
  86. 1060  Z=CR+RM.INC:X=FIX(NDX(Z)/8):N=NDX(Z)-X*8
  87. 1070  RM$="":FOR I=0 TO N:GET #1,X+I:RM$=RM$+AI$:NEXT I
  88. 1080  IF RIGHT$(RM$,1)=" " THEN RM$=LEFT$(RM$,LEN(RM$)-1):GOTO 1080
  89. 1090  PRINT RM$;:MID$(RE$,CR,1)="Y"
  90. 1100  IF R1=CR THEN 2000
  91. 1110  FOR I=1 TO 255
  92. 1120  IF OB$(I)=CHR$(255) THEN I=255: GOTO 1170
  93. 1130  IF FNL(I)<>CR THEN 1170
  94. 1140  X=FIX(NDX(I)/8):N=NDX(I)-8*X
  95. 1150  FOR J=0 TO N:GET #1,X+J
  96. 1160  PRINT AI$;:NEXT J:PRINT
  97. 1170  NEXT I
  98. 1180  R1=CR
  99. 2000  '
  100. 2010  ' CARRY OUT IMPLICIT ACTIVITY
  101. 2020  ' ---------------------------
  102. 2030  M=0
  103. 2040  M=M+1
  104. 2050  IF AA$(M)=CHR$(255) OR M=NAA+1 THEN 3000
  105. 2060  AS$=AA$(M)
  106. 2070  GOSUB 10000
  107. 2080  GOTO 2040
  108. 3000  '
  109. 3010  ' DO LOWER SCREEN DISPLAY
  110. 3020  ' -----------------------
  111. 3040  YPOS=CSRLIN
  112. 3050  XPOS=POS(X)
  113. 3060  LOCATE 25,1,0:PRINT"Location:";MID$(RM$(CR),7,64);
  114. 3070  MV$=""
  115. 3080  FOR Z=1 TO 6
  116. 3090  IF ASC(MID$(RM$(CR),Z,1))>0 THEN MV$=MV$+MID$("NSEWUD",Z,1)
  117. 3100  NEXT Z:PRINT USING" Exits: \    \";MV$;
  118. 3110  PRINT USING"Load:##\\Moves:#### Score:###";LD;CHR$(37);C(0);SC;
  119. 3120  LOCATE YPOS,XPOS,1
  120. 4000  '
  121. 4010  ' GET USER INPUT, PARSE VERB AND NOUN
  122. 4020  ' -----------------------------------
  123. 4030  V$=CHR$(0)
  124. 4040  N$=CHR$(0)
  125. 4050  O$=CHR$(0)
  126. 4060  V=0
  127. 4070  N=1
  128. 4080  O=0
  129. 4090  NL=0
  130. 4100  LINE INPUT ">";CO$:IF CO$="" THEN PRINT "Hello?":GOTO 3000
  131. 4110  C1$=CO$:FOR M=1 TO LEN(CO$):MID$(C1$,M,1)=FNUPCS$(MID$(CO$,M,1)):NEXT M
  132. 4140  IF LEN(C1$)=1 THEN 4600
  133. 4150  GOSUB 4500: V$=W$
  134. 4160  IF C1$>"" THEN GOSUB 4500: N$=W$
  135. 4170  IF C1$>"" THEN GOSUB 4500: O$=W$
  136. 4180  IF LEN(V$)>9 THEN V$=LEFT$(V$,9)
  137. 4190  IF LEN(N$)>9 THEN N$=LEFT$(N$,9)
  138. 4200  IF LEN(O$)>9 THEN O$=LEFT$(O$,9)
  139. 4210  C1$=CO$:GOSUB 4500:VI$=W$:I=1
  140. 4220  J=INSTR(VS$(I)," "+V$+" ")
  141. 4230  IF J=0 AND I<8 THEN I=I+1:GOTO 4220
  142. 4240  IF J>0 AND I<9 THEN V=1+FIX(J/10)+25*(I-1)
  143. 4250  IF V=0 THEN PRINT "I don't know how to ";VI$;".":GOTO 3000
  144. 4260  VL=ASC(MID$(VL$,V,1))-32:IF VL>0 THEN V=VL
  145. 4270  IF N$=CHR$(0) THEN 4400
  146. 4280  GOSUB 4500:NI$=W$:I=1
  147. 4290  J=INSTR(NS$(I)," "+N$+" ")
  148. 4300  IF J=0 AND I<8 THEN I=I+1:GOTO 4290
  149. 4310  IF J>0 AND I<9 THEN N=1+FIX(J/10)+25*(I-1)
  150. 4320  IF N>0 THEN NL=ASC(MID$(NL$,N,1))-32
  151. 4330  IF O$=CHR$(0) THEN 4400
  152. 4340  GOSUB 4500:OI$=W$:I=1
  153. 4350  J=INSTR(NS$(I)," "+O$+" ")
  154. 4360  IF J=0 AND I<8 THEN I=I+1: GOTO 4350
  155. 4370  IF J>0 AND I<9 THEN O=1+FIX(J/10)+25*(I-1)
  156. 4380  IF O>0 THEN NO=ASC(MID$(NL$,N,1))-32
  157. 4400  Z=NNOUNS*V+N+ACT.INC:Y=FIX(NDX(Z)/8)
  158. 4410  IF Y>0 THEN 4450
  159. 4420  IF N>1 THEN N=1: GOTO 4400
  160. 4430  ON V GOTO 24000,25000,21000
  161. 4440  PRINT "I don't know how to ";CO$;".": GOTO 3000
  162. 4450  N=NDX(Z)-8*Y:AS$="":FOR I=0 TO N:GET #1,Y+I
  163. 4460  AS$=AS$+AI$:NEXT I
  164. 4470  I=INSTR(AS$,CHR$(0)):AS$=LEFT$(AS$,I)
  165. 4490  GOTO 5000
  166. 4500  ' EXTRACT NEXT WORD
  167. 4510  IF C1$="" THEN W$=CHR$(0):GOTO 4570
  168. 4520  I=INSTR(C1$," ")
  169. 4530  IF I=0 THEN W$=C1$:C1$="":GOTO 4570
  170. 4540  W$=LEFT$(C1$,I-1)
  171. 4550  C1$=MID$(C1$,I+1,255)
  172. 4560  IF INSTR(UW$," "+W$+" ") THEN 4500
  173. 4570  RETURN
  174. 4600  ' SINGLE-CHR INPUT
  175. 4610  ON INSTR("IL",C1$) GOTO 22000,23000
  176. 4620  I=INSTR("NSEWUD",C1$)
  177. 4630  IF I=0 THEN PRINT "Huh?":GOTO 3000
  178. 4640  V=3:N=1:GOTO 4430
  179. 5000  '
  180. 5010  ' CARRY OUT ASSIGNED ACTIONS
  181. 5020  ' --------------------------
  182. 5030  C(0)=C(0)+1
  183. 5040  AF=0
  184. 5050  GOSUB 10000
  185. 5060  IF AF=0 THEN PRINT "That isn't possible under the circumstances."
  186. 5070  GOTO 1000
  187. 10000  '
  188. 10002  ' ACT UPON ACTION STRING
  189. 10004  ' ----------------------
  190. 10006  K=0:T=TRUE:TR=TRUE
  191. 10010  K=K+1
  192. 10014  IF K>LEN(AS$) THEN RETURN
  193. 10016  TN=ASC(MID$(AS$,K,1))
  194. 10020  F=(TN>127):TN=(TN AND 127):IF TN=0 THEN RETURN
  195. 10028  RF = ((NOT TR) AND (NOT F)) OR (TR AND F)
  196. 10030  A=FIX(TN/10)+1:B=TN-10*A+11
  197. 10034  ON A GOTO 10038,10040,10042,10044,10046,10048,10098,10098,10098
  198. 10036  ON A GOTO 10098,10098,10098,10098
  199. 10038  ON B-1 GOTO 10100,10200,10300,10400,10500,10600,10700,10800,10900
  200. 10040  ON B GOTO 11000,11100,11200,11300,11400,11500,11600,11700,11800,11900
  201. 10042  ON B GOTO 12000,12100,12200,12300,12400,12500,12600,12700,12800,12900
  202. 10044  ON B GOTO 13000,13100,13200,13300,13400,13500,13600,13700,13800,13900
  203. 10046  ON B GOTO 14000,14100,14200,14300,14400,14500,14600,14700,14800,14900
  204. 10048  ON B GOTO 15000,15100,15200,15300,15400,15500,15600,15700,15800
  205. 10098  PRINT "Undefined token encountered:";TN:GOTO 10010
  206. 10100  ' HASX X
  207. 10110  K=K+1:X=FNX(AS$,K)
  208. 10120  T=(FNL(X)=255)
  209. 10130  GOTO 26000
  210. 10200  ' NCRX X
  211. 10210  K=K+1:X=FNX(AS$,K)
  212. 10220  T=(FNL(X)=CR)
  213. 10230  GOTO 26000
  214. 10300  ' AVLX X
  215. 10310  K=K+1:X=FNX(AS$,K)
  216. 10320  T=((FNL(X)=255) OR (FNL(X)=CR))
  217. 10330  GOTO 26000
  218. 10400  ' XINY X Y
  219. 10410  K=K+1:X=FNX(AS$,K)
  220. 10420  K=K+1:Y=FNX(AS$,K)
  221. 10430  T=(FNL(X)=Y)
  222. 10440  GOTO 26000
  223. 10500  ' NSRX X
  224. 10510  K=K+1:X=FNX(AS$,K)
  225. 10520  T=(FNL(X)=ASC(MID$(OB$(X),2,1)))
  226. 10530  GOTO 26000
  227. 10600  ' NR0X X
  228. 10610  K=K+1:X=FNX(AS$,K)
  229. 10620  T=(FNL(X)=0)
  230. 10630  GOTO 26000
  231. 10700  ' XW/Y X Y
  232. 10710  K=K+1:X=FNX(AS$,K)
  233. 10720  K=K+1:Y=FNX(AS$,K)
  234. 10730  T=(FNL(X)=FNL(Y))
  235. 10740  GOTO 26000
  236. 10800  ' HASL
  237. 10810  T=(FNL(NL)=255)
  238. 10820  GOTO 26000
  239. 10900  ' NCRL
  240. 10910  T=(FNL(NL)=CR)
  241. 10920  GOTO 26000
  242. 11000  ' AVLL
  243. 11010  T=(FNL(NL)=CR OR FNL(NL)=255)
  244. 11020  GOTO 26000
  245. 11100  ' LINX X
  246. 11110  K=K+1:X=FNX(AS$,K)
  247. 11120  T=(FNL(NL)=X)
  248. 11130  GOTO 26000
  249. 11200  ' NSRL
  250. 11210  T=(FNL(NL)=ASC(MID$(OB$(NL),2,1)))
  251. 11220  GOTO 26000
  252. 11300  ' NR0L
  253. 11310  K=K+1:X=FNX(AS$,K)
  254. 11320  T=(FNL(NL)=0)
  255. 11330  GOTO 26000
  256. 11400  ' LW/X X
  257. 11410  K=K+1:X=FNX(AS$,K)
  258. 11420  T=(FNL(NL)=FNL(X))
  259. 11430  GOTO 26000
  260. 11500  ' RAND X
  261. 11510  K=K+1:X=FNX(AS$,K)
  262. 11520  T=(100*RND<=X)
  263. 11530  GOTO 26000
  264. 11600  ' CEQN #C N
  265. 11610  K=K+1:C=FNX(AS$,K)
  266. 11620  K=K+1:N=FNX(AS$,K)
  267. 11630  T=(C(C)=N)
  268. 11640  GOTO 26000
  269. 11700  ' CGEN #C N
  270. 11710  K=K+1:C=FNX(AS$,K)
  271. 11720  K=K+1:N=FNX(AS$,K)
  272. 11730  T=(C(C)>=N)
  273. 11740  GOTO 26000
  274. 11800  ' CEQC #C #D
  275. 11810  K=K+1:C=FNX(AS$,K)
  276. 11820  K=K+1:D=FNX(AS$,K)
  277. 11830  T=(C(C)=C(D))
  278. 11840  GOTO 26000
  279. 11900  ' CGEC #C #D
  280. 11910  K=K+1:C=FNX(AS$,K)
  281. 11920  K=K+1:D=FNX(AS$,K)
  282. 11930  T=(C(C)>=C(D))
  283. 11940  GOTO 26000
  284. 12000  ' XSET N
  285. 12010  K=K+1: X=FNX(AS$,K)
  286. 12020  FB=FIX(X/8)
  287. 12030  T=((BF(FB) AND MASK(X))>0)
  288. 12040  GOTO 26000
  289. 12100  ' INRX X
  290. 12110  K=K+1:X=FNX(AS$,K)
  291. 12120  T=(CR=X)
  292. 12130  GOTO 26000
  293. 12200  ' LIGH
  294. 12210  T=LS
  295. 12220  GOTO 26000
  296. 12300  ' LDGT X
  297. 12310  K=K+1:X=FNX(AS$,K)
  298. 12320  T=(LD>X)
  299. 12330  GOTO 26000
  300. 12400  ' OBJ= X
  301. 12410  K=K+1:X=FNX(AS$,K)
  302. 12420  T=(X=NO)
  303. 12430  GOTO 26000
  304. 12500  ' X2RY X Y
  305. 12510  K=K+1:X=FNX(AS$,K)
  306. 12520  K=K+1:Y=FNX(AS$,K)
  307. 12530  IF RF THEN 10010 ELSE AF=1
  308. 12540  IF FNL(X)<255 AND Y=255 THEN LD=LD+FNW(X)
  309. 12550  IF FNL(X)=255 AND Y<255 THEN LD=LD-FNW(X)
  310. 12560  MID$(OB$(X),1,1)=CHR$(Y)
  311. 12570  GOTO 10010
  312. 12600  ' X2OY X Y
  313. 12610  K=K+1:X=FNX(AS$,K)
  314. 12620  K=K+1:Y=FNX(AS$,K)
  315. 12630  IF RF THEN 10010 ELSE AF=1
  316. 12640  IF FNL(X)<255 AND FNL(Y)=255 THEN LD=LD+FNW(X)
  317. 12650  IF FNL(X)=255 AND FNL(Y)<255 THEN LD=LD-FNW(X)
  318. 12660  MID$(OB$(X),1,1)=LEFT$(OB$(Y),1)
  319. 12670  GOTO 10010
  320. 12700  ' X2CR X
  321. 12710  K=K+1:X=FNX(AS$,K)
  322. 12720  IF RF THEN 10010 ELSE AF=1
  323. 12730  IF FNL(X)=255 THEN LD=LD-FNW(X)
  324. 12740  MID$(OB$(X),1,1)=CHR$(CR)
  325. 12750  GOTO 10010
  326. 12800  ' X2SR X
  327. 12810  K=K+1:X=FNX(AS$,K)
  328. 12820  IF RF THEN 10010 ELSE AF=1
  329. 12830  IF FNL(X)=255 THEN LD=LD-FNW(X)
  330. 12840  MID$(OB$(X),1,1)=MID$(OB$(X),2,1)
  331. 12850  GOTO 10010
  332. 12900  ' X2R0 X
  333. 12910  K=K+1:X=FNX(AS$,K)
  334. 12920  IF RF THEN 10010 ELSE AF=1
  335. 12930  IF FNL(X)=255 THEN LD=LD-FNW(X)
  336. 12940  MID$(OB$(X),1,1)=CHR$(0)
  337. 12950  GOTO 10010
  338. 13000  ' X<>Y X Y
  339. 13010  K=K+1:X=FNX(AS$,K)
  340. 13020  K=K+1:Y=FNX(AS$,K)
  341. 13030  IF RF THEN 10010 ELSE AF=1
  342. 13040  IF FNL(X)<255 AND FNL(Y)=255 THEN LD=LD+FNW(X)-FNW(Y)
  343. 13050  IF FNL(X)=255 AND FNL(Y)<255 THEN LD=LD-FNW(X)+FNW(X)
  344. 13060  L$=CHR$(FNL(X))
  345. 13070  MID$(OB$(X),1,1)=LEFT$(OB$(Y),1)
  346. 13080  MID$(OB$(Y),1,1)=L$
  347. 13090  GOTO 10010
  348. 13100  ' L2RX X
  349. 13110  K=K+1:X=FNX(AS$,K)
  350. 13120  IF RF THEN 10010 ELSE AF=1
  351. 13130  IF FNL(NL)<255 AND X=255 THEN LD=LD+FNW(NL)
  352. 13140  IF FNL(NL)=255 AND X<255 THEN LD=LD-FNW(NL)
  353. 13150  MID$(OB$(NL),1,1)=CHR$(X)
  354. 13160  GOTO 10010
  355. 13200  ' L2OX X
  356. 13210  K=K+1:X=FNX(AS$,K)
  357. 13220  IF RF THEN 10010 ELSE AF=1
  358. 13230  IF FNL(NL)<255 AND X=255 THEN LD=LD+FNW(NL)
  359. 13240  IF FNL(NL)=255 AND X<255 THEN LD=LD-FNW(NL)
  360. 13250  MID$(OB$(NL),1,1)=LEFT$(OB$(X),1)
  361. 13260  GOTO 10010
  362. 13300  ' L2CR
  363. 13310  IF RF THEN 10010 ELSE AF=1
  364. 13320  IF FNL(NL)=255 THEN LD=LD-FNW(NL)
  365. 13330  MID$(OB$(NL),1,1)=CHR$(CR)
  366. 13340  GOTO 10010
  367. 13400  ' L2SR
  368. 13410  IF RF THEN 10010 ELSE AF=1
  369. 13420  IF FNL(NL)=255 AND MID$(OB$(X),2,1)<>255 THEN LD=LD-FNW(NL)
  370. 13430  MID$(OB$(NL),1,1)=MID$(OB$(NL),2,1)
  371. 13440  GOTO 10010
  372. 13500  ' L2R0
  373. 13510  IF RF THEN 10010 ELSE AF=1
  374. 13520  IF FNL(NL)=255 THEN LD=LD-FNW(NL)
  375. 13530  MID$(OB$(NL),1,1)=CHR$(0)
  376. 13540  GOTO 26000
  377. 13600  ' L<>X X
  378. 13610  K=K+1:X=FNX(AS$,K)
  379. 13620  IF RF THEN 10010 ELSE AF=1
  380. 13630  IF FNL(NL)=255 AND FNL(X)<255 THEN LD=LD-FNW(NL)+FNW(X)
  381. 13640  IF FNL(NL)<255 AND FNL(X)=255 THEN LD=LD+FNW(NL)-FNW(X)
  382. 13650  L$=LEFT$(OB$(NL),1)
  383. 13660  MID$(OB$(NL),1,1)=LEFT$(OB$(X),1)
  384. 13670  MID$(OB$(X),1,1)=L$
  385. 13680  GOTO 10010
  386. 13700  ' DROP
  387. 13710  IF RF THEN 10010 ELSE AF=1
  388. 13720  FOR Z=1 TO NOB
  389. 13740  IF FNL(Z)<255 THEN 13770
  390. 13750  MID$(OB$(Z),1,1)=CHR$(CR)
  391. 13760  LD=LD-FNW(Z)
  392. 13770  NEXT Z
  393. 13780  GOTO 10010
  394. 13800  ' P2RX X
  395. 13810  K=K+1:X=FNX(AS$,K)
  396. 13820  IF RF THEN 10010 ELSE AF=1
  397. 13830  CR=X
  398. 13840  GOTO 10010
  399. 13900  ' P2OX X
  400. 13910  K=K+1:X=FNX(AS$,K)
  401. 13920  IF RF THEN 10010 ELSE AF=1
  402. 13930  CR=FNL(X)
  403. 13940  GOTO 10010
  404. 14000  ' SCO+ X
  405. 14010  K=K+1:X=FNX(AS$,K)
  406. 14020  IF RF THEN 10010 ELSE AF=1
  407. 14030  IF X>127 THEN X=FNZ(X)
  408. 14040  SC=SC+X
  409. 14050  GOTO 10010
  410. 14100  ' HEAL X
  411. 14110  K=K+1:X=FNX(AS$,K)
  412. 14120  IF RF THEN 10010 ELSE AF=1
  413. 14130  IF X>127 THEN X=FNZ(X)
  414. 14140  HE=HE+X
  415. 14150  IF HE>100 THEN HE=100
  416. 14160  IF HE<0 THEN HE=0
  417. 14170  GOTO 10010
  418. 14200  ' CTX+ #C Y
  419. 14210  K=K+1:C=FNX(AS$,K)
  420. 14220  K=K+1:Y=FNX(AS$,K)
  421. 14230  IF RF THEN 10010 ELSE AF=1
  422. 14240  IF Y>127 THEN Y=FNZ(Y)
  423. 14250  C(C)=C(C)+Y
  424. 14260  GOTO 10010
  425. 14300  ' CTX= #C Y
  426. 14310  K=K+1:C=FNX(AS$,K)
  427. 14320  K=K+1:Y=FNX(AS$,K)
  428. 14330  IF RF THEN 10010 ELSE AF=1
  429. 14340  IF Y>127 THEN Y=FNZ(Y)
  430. 14350  C(C)=Y
  431. 14360  GOTO 10010
  432. 14400  ' SETX X
  433. 14410  K=K+1:X=FNX(AS$,K)
  434. 14420  IF RF THEN 10010 ELSE AF=1
  435. 14430  FB=FIX(X/8)
  436. 14440  BF(FB)=(BF(FB) OR MASK(X))
  437. 14450  GOTO 10010
  438. 14500  ' CLRX X
  439. 14510  K=K+1:X=FNX(AS$,K)
  440. 14520  IF RF THEN 10010 ELSE AF=1
  441. 14530  FB=FIX(X/8)
  442. 14540  BF(FB)=(BF(FB) AND (NOT MASK(X)))
  443. 14550  GOTO 10010
  444. 14600  ' MSGX X
  445. 14610  K=K+1:X=FNX(AS$,K)
  446. 14620  IF RF THEN 10010 ELSE AF=1
  447. 14630  Z=X+MSG.INC:Y=FIX(NDX(Z)/8):N=NDX(Z)-8*Y
  448. 14640  MSG$="":FOR I=0 TO N:GET #1,Y+I:MSG$=MSG$+AI$:NEXT I
  449. 14650  IF RIGHT$(MSG$,1)=" " THEN MSG$=LEFT$(MSG$,LEN(MSG$)-1):GOTO 14650
  450. 14660  PRINT MSG$;:GOTO 10010
  451. 14700  ' ENDG
  452. 14710  IF RF THEN 10010 ELSE AF=1
  453. 14720  PRINT "The game is over.  Your final score is";STR$(SC);"."
  454. 14740  ON ERROR GOTO 0
  455. 14750  CLOSE
  456. 14770  END
  457. 14800  ' LMP1
  458. 14810  IF RF THEN 10010 ELSE AF=1
  459. 14820  LS=TRUE
  460. 14830  GOTO 10010
  461. 14900  ' LMP0
  462. 14910  IF RF THEN 10010 ELSE AF=1
  463. 14920  LS=FALSE
  464. 14930  GOTO 10010
  465. 15000  ' DIAG
  466. 15010  IF RF THEN 10010 ELSE AF=1
  467. 15020  PRINT "You feel ";
  468. 15030  ON 1+FIX((HE-1)/20) GOTO 15040,15050,15060,15070,15080
  469. 15040  PRINT "just plain awful.": GOTO 10010
  470. 15050  PRINT "lousy.": GOTO 10010
  471. 15060  PRINT "a bit poorly.": GOTO 10010
  472. 15070  PRINT "pretty well.": GOTO 10010
  473. 15080  PRINT "just fine.": GOTO 10010
  474. 15100  ' WAIT X
  475. 15110  K=K+1:X=FNX(AS$,K)
  476. 15120  IF RF THEN 10010 ELSE AF=1
  477. 15130  FOR Z=1 TO X/250: NEXT
  478. 15140  GOTO 26000
  479. 15200  ' ECHO
  480. 15210  IF RF THEN 10010 ELSE AF=1
  481. 15220  PRINT " "CO$" ";
  482. 15230  GOTO 26000
  483. 15300  ' RPTV
  484. 15310  IF RF THEN 10010 ELSE AF=1
  485. 15320  PRINT " "VI$" ";
  486. 15330  GOTO 26000
  487. 15400  ' RPTN
  488. 15410  IF RF THEN 10010 ELSE AF=1
  489. 15420  PRINT " "NI$" ";
  490. 15430  GOTO 26000
  491. 15500  ' RPTO
  492. 15510  IF RF THEN 10010 ELSE AF=1
  493. 15520  PRINT " "OI$" ";
  494. 15530  GOTO 26000
  495. 15600  ' ELSE
  496. 15610  IF TR THEN RETURN
  497. 15620  TR=TRUE
  498. 15630  GOTO 10010
  499. 15700  ' SAVE
  500. 15710  IF RF THEN 10010 ELSE  AF=1
  501. 15720  LINE INPUT "Save file";FL$:IF FL$="" THEN PRINT"No Save file given. Save not done.":GOTO 26000
  502. 15730  IF INSTR(FL$,".")=0 THEN FL$=FL$+".SAV" 
  503. 15735  OPEN "O",3,FL$
  504. 15740  WRITE #3,WT,HS,LS,CR,LD,SC,RE$
  505. 15750  FOR I=0 TO 32:WRITE #3,BF(I):NEXT
  506. 15760  FOR I=0 TO 255: WRITE #3,C(I):NEXT
  507. 15770  FOR I=0 TO NOB:WRITE #3,ASC(OB$(I)):NEXT
  508. 15780  CLOSE #3
  509. 15790  GOTO 26000
  510. 15800  ' LOAD
  511. 15810  IF RF THEN 10010 ELSE AF=1
  512. 15820  LINE INPUT "Load file";FL$:IF FL$="" THEN PRINT "No Load file given. Restore not done.":GOTO 26000
  513. 15830  IF INSTR(FL$,".")=0 THEN FL$=FL$+".SAV" 
  514. 15835  OPEN "I",3,FL$
  515. 15840  INPUT #3,WT,HS,LS,CR,LD,SC,RE$
  516. 15850  FOR I=0 TO 32:INPUT #3,BF(I):NEXT
  517. 15860  FOR I=0 TO 255:INPUT #3,C(I):NEXT
  518. 15870  FOR I=1 TO NOB:INPUT #3,J
  519. 15871  IF OB$(I)>"" THEN MID$(OB$(I),1,1)=CHR$(J)
  520. 15872  NEXT
  521. 15880  CLOSE #3
  522. 15890  GOTO 26000
  523. 20000  '
  524. 20010  ' DEDICATED ACTION ROUTINES
  525. 20020  ' -------------------------
  526. 21000  '
  527. 21010  ' HANDLE N,S,E,W,U OR D
  528. 21020  ' ---------------------
  529. 21030  IF LEN(CO$)>1 THEN CO$=LEFT$(N$,1)
  530. 21040  I=INSTR("NSEWUDnsewud",CO$):IF I=0 THEN 1000
  531. 21050  C(0)=C(0)+1:IF I>6 THEN I=I-6
  532. 21060  NR=ASC(MID$(RM$(CR),I,1))
  533. 21070  IF NR=0 THEN PRINT "No passage that way.": GOTO 1000
  534. 21080  CR=NR
  535. 21090  R1=-1
  536. 21100  GOTO 1000
  537. 22000  '
  538. 22010  ' HANDLE INVENTORY
  539. 22020  ' ----------------
  540. 22030  C(0)=C(0)+1
  541. 22040  PRINT "You are carrying:"
  542. 22050  K=0
  543. 22060  FOR Z=1 TO 255
  544. 22065  IF OB$(Z)=CHR$(255) THEN Z=255: GOTO 22100
  545. 22070  IF FNL(Z)<255 THEN 22100
  546. 22080  PRINT "  ";MID$(OB$(Z),5,26)
  547. 22090  K=1
  548. 22100  NEXT
  549. 22110  IF K=0 THEN PRINT "  Nothing."
  550. 22120  GOTO 1000
  551. 23000  '
  552. 23010  ' HANDLE LOOK
  553. 23020  ' -----------
  554. 23030  C(0)=C(0)+1
  555. 23040  MID$(RE$,CR,1)="N"
  556. 23050  R1=0
  557. 23060  GOTO 1000
  558. 24000  '
  559. 24010  ' HANDLE GET
  560. 24020  ' ----------
  561. 24030  C(0)=C(0)+1
  562. 24040  IF NL=0 THEN PRINT "You can't do that.": GOTO 1000
  563. 24050  IF FNL(NL)<>CR THEN PRINT "What "NI$"?": GOTO 1000
  564. 24060  IF FNL(NL)=255 THEN PRINT "You already have it!": GOTO 1000
  565. 24070  WT=ASC(MID$(OB$(NL),3,1))
  566. 24080  IF WT=255 THEN PRINT "You are quite incapable of moving the "NI$".": GOTO 1000
  567. 24090  IF LD+WT>100 THEN PRINT "You can't carry that much more weight.": GOTO 1000
  568. 24100  MID$(OB$(NL),1,1)=CHR$(255)
  569. 24110  LD=LD+ASC(MID$(OB$(NL),3,1))
  570. 24120  SC=SC+ASC(MID$(OB$(NL),4,1))
  571. 24130  PRINT "The "NI$" taken."
  572. 24140  GOTO 1000
  573. 25000  '
  574. 25010  ' HANDLE DROP
  575. 25020  ' --------------
  576. 25030  C(0)=C(0)+1
  577. 25040  IF NL=0 THEN 1000
  578. 25050  IF FNL(NL)<>255 THEN PRINT "You aren't carrying any ";NI$: GOTO 1000
  579. 25060  WT=ASC(MID$(OB$(NL),3,1))
  580. 25070  MID$(OB$(NL),1,1)=CHR$(CR)
  581. 25080  LD=LD-ASC(MID$(OB$(NL),3,1))
  582. 25090  SC=SC-ASC(MID$(OB$(NL),4,1))
  583. 25100  PRINT "The "NI$" released."
  584. 25110  GOTO 1000
  585. 26000  '
  586. 26010  ' UPDATE TRUTH MASK ON RETURN FROM TEST
  587. 26020  ' -------------------------------------
  588. 26030  T=(T AND NOT RF) OR (NOT T AND RF)
  589. 26040  TR=TR AND T
  590. 26050  GOTO 10010
  591. 30000  '
  592. 30010  ' ERROR TRAP
  593. 30020  ' ----------
  594. 30030  PRINT
  595. 30040  PRINT "<*** ERROR";ERR;"has occured in line";ERL;"***>"
  596. 30050  PRINT
  597. 30060  PRINT "Press ENTER to attempt recovery or ESC to stop run ";
  598. 30070  A$=INKEY$:IF A$="" THEN 30070
  599. 30080  IF A$=CHR$(27) THEN ON ERROR GOTO 0
  600. 30090  IF A$=CHR$(13) THEN RESUME 1000
  601. 30100  BEEP:GOTO 30070
  602. 50000  ' LAST LINE
  603.